home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / ERRORHAN.MOD < prev    next >
Text File  |  1987-04-23  |  3KB  |  86 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Error_Handler --- Handle program aborts by exiting gracefully    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Error_Handler;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Error_Handler                                        *)
  10. (*                                                                      *)
  11. (*     Purpose:    Handle PibTerm program aborts by halting gracefully  *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Error_Handler( ErrNo , ErrAddr : INTEGER );                   *)
  16. (*                                                                      *)
  17. (*           ErrNo    --- error number/type                             *)
  18. (*           ErrAddr  --- address where error occurred                  *)
  19. (*                                                                      *)
  20. (*     Remarks:                                                         *)
  21. (*                                                                      *)
  22. (*        This routine needs to be cleaned up to handle file closing    *)
  23. (*        better at some point.                                         *)
  24. (*                                                                      *)
  25. (*----------------------------------------------------------------------*)
  26.  
  27. VAR
  28.    I : INTEGER;
  29.  
  30. (* STRUCTURED *) Const
  31.    Sorry_Mess  : STRING[60]
  32.                  = 'Sorry, there has been a system error, please call back later';
  33.    Discon_Mess : STRING[17]
  34.                  = 'Disconnecting....';
  35.  
  36. BEGIN (* Error_Handler *)
  37.                                    (* Make sure we're in text mode *)
  38.    TextMode( Text_Mode );
  39.                                    (* Send notice of fatal error (also to  *)
  40.                                    (* caller in host mode) and quit.       *)
  41.    IF ( ErrNo > 0 ) THEN
  42.       BEGIN
  43.  
  44.          IF Host_Mode THEN
  45.             BEGIN
  46.                Async_Send_String(' ');
  47.                Async_Send_String(Sorry_Mess);
  48.                Async_Send_String(Discon_Mess);
  49.                WRITELN;
  50.                WRITELN(Sorry_Mess);
  51.                WRITELN(Discon_Mess);
  52.             END
  53.          ELSE
  54.             BEGIN
  55.                WRITELN;
  56.                WRITELN('Sorry, there has been a serious PibTerm error.');
  57.             END;
  58.  
  59.                                    (* Report error number and type *)
  60.  
  61.          I := LO( ErrNo );
  62.  
  63.          WRITE('Error number: ', Dec_To_Hex( I ), ' = ' );
  64.  
  65.          CASE HI( ErrNo ) OF
  66.             0: WRITE('User break');
  67.             1: WRITE('I/O error');
  68.             2: WRITE('Run time error');
  69.          ELSE
  70.             WRITE('Unknown Error');
  71.          END (* CASE *);
  72.  
  73.          WRITELN(' at address ',Dec_To_Hex( ErrAddr ),' (hexadecimal)');
  74.  
  75.       END;
  76.                                    (* Close down all program facilities *)
  77.    FiniTerm;
  78.  
  79.    WRITELN('PibTerm execution stopped ... ');
  80.    DELAY  ( Three_Second_Delay    );
  81.  
  82.                                    (* Quit *)
  83.    Turbo_Halt( 2 );
  84.  
  85. END   (* Error_Handler *);
  86.